home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic 5 Developer's Kit / vb5 dev kit.iso / dev / desaware / verstamp / vervrfy.bas < prev    next >
Encoding:
BASIC Source File  |  1996-03-22  |  17.3 KB  |  439 lines
  1. Attribute VB_Name = "VerVrfy"
  2. Option Explicit
  3.  
  4. 'contains version info for reference files that a conflict was found for
  5. Type VerConflictType
  6.     ReferenceFile As String     'name of reference file that a conflict was detected on
  7.     ReferenceVersion As String  'reference file version
  8.     ReferenceDate As String     'reference file date
  9.     ReferenceSize As String     'reference file size
  10.     ReferenceFlags As Long      'reference file flags
  11.     'contains index to the ConflictListType array, there can
  12.     'be more than one ConflictListType for each VerConflictType
  13.     ConflictListIndex As Integer
  14.                                     
  15. End Type
  16.  
  17. ' This structure holds information on the conflicting files, it is like
  18. ' a linked list, the VerConflictType contains an index to the first conflict,
  19. ' the last conflict contains a -1 in the index.
  20. ' Only the first conflict file is an actual conflict, the remaining files
  21. ' just indicates where else on the computer can the reference file be found.
  22. Type ConflictListType
  23.     ConflictFile As String      'string containing path of file found with same name
  24.                                 'as the reference file, blank if file not found
  25.     ConflictVersion As String   'version of first conflict file
  26.     ConflictDate As String      'date of first conflict file
  27.     ConflictSize As String      'size of first conflict file
  28.     ConflictFlags As Long       'conflict flags of first conflict file
  29.     ConflictFXFlags As Long     'fixed file info flags of first conflict file
  30.     ConflictNext As Integer     'next file in the conflict list, -1 if this is last one
  31. End Type
  32.  
  33. Global VerConflictList() As VerConflictType
  34. Global ConflictList() As ConflictListType
  35.  
  36. Global ConflictFilesFound%      'files found during scan that are in conflict with embedded files
  37. Global FileToCheck$             'specifies the name of file to verify for
  38. Global EmbedInfoFound%          'indicates whether we found other files during scan (we use this to
  39.                                 'determine whether the file contains embedded information or not)
  40. Global ConflictFormCaption$     'Caption for the conflict report form, if string is empty, then will default to form's caption.
  41. 'Version Information constants
  42. Global Const VC_GETALL = -1
  43. Global Const VC_REFERENCEFILE = 1
  44.  
  45. 'Version Conflict constants
  46. Global Const CF_OLDERFILE = &H1
  47. Global Const CF_NEWERFILE = &H2
  48. Global Const CF_OLDERVERSION = &H4
  49. Global Const CF_NEWERVERSION = &H8
  50. Global Const CF_SPECIALVERSION = &H10
  51. Global Const CF_ALWAYSWARN = &H20
  52. Global Const CF_FILEINMEMORY = &H40
  53. Global Const CF_FILENOTFOUND = &H80
  54. Global Const CF_NOVERSIONINFO = &H100
  55. Global Const CF_FILESIZELARGER = &H200
  56. Global Const CF_FILESIZESMALLER = &H400
  57. Global Const CF_NOTINREGISTRY = &H800
  58.  
  59. 'The following are duplicates of the VS_FF_* constants from Verinfo.bas
  60. Global Const VS_FF_DEBUG = &H1&
  61. Global Const VS_FF_PRERELEASE = &H2&
  62. Global Const VS_FF_PATCHED = &H4&
  63. Global Const VS_FF_PRIVATEBUILD = &H8&
  64. Global Const VS_FF_INFOINFERRED = &H10&
  65. Global Const VS_FF_SPECIALBUILD = &H20&
  66.  
  67. 'Text formatting constants
  68. Global NL As String 'new line
  69. Global TB As String 'tab
  70.  
  71. 'Tab Stop messages
  72. #If Win32 Then
  73.     Global Const EM_SETTABSTOPS = &HB0 + 27
  74.     Global Const EM_SETREADONLY = &HB0 + 31
  75.     Global Const LB_SETTABSTOPS = &H180 + 19
  76. #Else
  77.     Global Const EM_SETTABSTOPS = &H400 + 27
  78.     Global Const EM_SETREADONLY = &H400 + 31
  79.     Global Const LB_SETTABSTOPS = &H400 + 19
  80. #End If
  81.  
  82. 'File Open & Save Common Dialog constants
  83. Global Const OFN_READONLY = &H1&
  84. Global Const OFN_OVERWRITEPROMPT = &H2&
  85. Global Const OFN_HIDEREADONLY = &H4&
  86. Global Const OFN_NOCHANGEDIR = &H8&
  87. Global Const OFN_SHOWHELP = &H10&
  88. Global Const OFN_NOVALIDATE = &H100&
  89. Global Const OFN_ALLOWMULTISELECT = &H200&
  90. Global Const OFN_EXTENSIONDIFFERENT = &H400&
  91. Global Const OFN_PATHMUSTEXIST = &H800&
  92. Global Const OFN_FILEMUSTEXIST = &H1000&
  93. Global Const OFN_CREATEPROMPT = &H2000&
  94. Global Const OFN_SHAREAWARE = &H4000&
  95. Global Const OFN_NOREADONLYRETURN = &H8000&
  96. Global Const OFN_NOTESTFILECREATE = &H10000
  97.  
  98. Global Const TECHNOLOGY = 2 '  Device classification
  99. Global Const HORZSIZE = 4   '  Horizontal size in millimeters
  100. Global Const VERTSIZE = 6   '  Vertical size in millimeters
  101. Global Const HORZRES = 8    '  Horizontal width in pixels
  102. Global Const VERTRES = 10   '  Vertical width in pixels
  103. Global Const BITSPIXEL = 12 '  Number of bits per pixel
  104. Global Const PLANES = 14    '  Number of planes
  105.  
  106. ' 32-Bit API Functions
  107. #If Win32 Then
  108.     Declare Function GetDeviceCaps Lib "GDI32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
  109.     Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  110.     Declare Function SendMessageByNum Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  111.     Declare Function WinHelpBynum Lib "User32" Alias "WinHelpA" (ByVal hWnd As Long, ByVal lpHelpFile As String, ByVal wCommand As Long, ByVal dwData As Long) As Long
  112. #Else
  113.     ' 16-Bit API Functions
  114.     Declare Function GetDeviceCaps Lib "GDI" (ByVal hDC As Integer, ByVal nIndex As Integer) As Integer
  115.     Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
  116.     Declare Function SendMessageByNum Lib "User" Alias "SendMessage" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Long) As Long
  117.     Declare Function WinHelpBynum Lib "User" Alias "WinHelp" (ByVal hWnd As Integer, ByVal lpHelpFile As String, ByVal wCommand As Integer, ByVal dwData As Long) As Integer
  118. #End If
  119. Sub FillConflictFileListBox(ByVal append2ctl%, lbox As Control)
  120. Dim cfidx%, listidx%
  121.  
  122.     If Not append2ctl% Then lbox.Clear
  123.     
  124.     ' ConflictFilesFound contains the number of conflicting files that were found.
  125.     If ConflictFilesFound% > 0 Then
  126.         cfidx% = UBound(VerConflictList)
  127.         ' Get list of conflicting file names and place them in the list box.
  128.         For listidx% = 1 To cfidx% Step 1
  129.             lbox.AddItem VerConflictList(listidx%).ReferenceFile
  130.         Next
  131.     Else
  132.         ' If no conflicts were found, check to see whether it was
  133.         ' because the target file did not contain any embedded info.
  134.         If EmbedInfoFound% Then
  135.             lbox.AddItem NOCONFLICT
  136.         Else
  137.             lbox.AddItem NOEMBEDDED
  138.         End If
  139.     End If
  140.     
  141. End Sub
  142.  
  143. '
  144. ' Determine the number of colors supported by the current device
  145. '
  146. Function GetColorCount&(f As Form)
  147.     Dim pl&, bp&
  148.     pl& = GetDeviceCaps(f.hDC, PLANES)
  149.     bp& = GetDeviceCaps(f.hDC, BITSPIXEL)
  150.     GetColorCount& = 2 ^ (pl& * bp&)
  151. End Function
  152.  
  153. Function GetConflictInfo(ByVal ctype%, ByVal Index%, ByVal delim$) As String
  154. Dim tstr$
  155. Dim vclist%, vcount%
  156.  
  157.     If ctype% = VC_REFERENCEFILE Then
  158.         If Index% = VC_GETALL Then
  159.             vclist% = UBound(VerConflictList)
  160.             For vcount% = 1 To vclist% Step 1
  161.                 tstr$ = tstr$ & VerConflictList(vcount%).ReferenceFile & delim$
  162.             Next
  163.         Else
  164.             tstr$ = tstr$ & VerConflictList(ctype%).ReferenceFile & delim$
  165.         End If
  166.     End If
  167.  
  168.     GetConflictInfo = tstr$
  169. End Function
  170.  
  171. Function GetDetailConflictInfo(ByVal vcidx%) As String
  172. Dim clistindex%
  173. Dim eflags&
  174. Dim tstr$
  175.     
  176.     If vcidx% > UBound(VerConflictList) Then Exit Function
  177.  
  178.     'get index to conflict array list
  179.     clistindex% = VerConflictList(vcidx%).ConflictListIndex
  180.  
  181.     tstr$ = CONFLICT_REFFILEDATE & TB & VerConflictList(vcidx%).ReferenceDate & NL
  182.     tstr$ = tstr$ & CONFLICT_REFFILESIZE & TB & VerConflictList(vcidx%).ReferenceSize & NL
  183.     tstr$ = tstr$ & CONFLICT_REFFILEVER & TB & VerConflictList(vcidx%).ReferenceVersion & NL & NL
  184.     
  185.     tstr$ = tstr$ & CONFLICT_FILEFOUND & TB
  186.     
  187.     'get conflict information, conflict information is currently found for
  188.     'only the first conflict file
  189.     tstr$ = tstr$ & ConflictList(clistindex%).ConflictFile & NL
  190.     eflags& = ConflictList(clistindex%).ConflictFlags
  191.  
  192.     ' Display the necessary version information based on conflict found.
  193.     ' We can filter out certain messages depending on the error found.
  194.     ' For example:
  195.  
  196.     'If (eflags& And &H3) Then
  197.         'date conflict, get date string
  198.     '    tstr$ = tstr$ & ConflictList(clistindex%).ConflictDate & TB
  199.     'End If
  200.  
  201.     ' For now, we'll always display date and size
  202.     tstr$ = tstr$ & CONFLICT_FILEDATE & TB & ConflictList(clistindex%).ConflictDate & NL
  203.     tstr$ = tstr$ & CONFLICT_FILESIZE & TB & ConflictList(clistindex%).ConflictSize & NL
  204.  
  205.     'If (eflags& And &HC) Then
  206.         'version conflict, get version string
  207.     '    tstr$ = tstr$ & ConflictList(clistindex%).ConflictVersion & TB
  208.     'End If
  209.  
  210.     ' For now, we'll always display version
  211.     tstr$ = tstr$ & CONFLICT_FILEVER & TB & ConflictList(clistindex%).ConflictVersion & NL
  212.  
  213.     tstr$ = tstr$ & NL & GetWarnings(eflags&, NL, ConflictList(clistindex%).ConflictFXFlags)
  214.     clistindex% = ConflictList(clistindex%).ConflictNext
  215.  
  216.     If clistindex% < 0 Then
  217.         GetDetailConflictInfo = tstr$
  218.         Exit Function
  219.     End If
  220.  
  221.     ' If more than one file was found on the system, list their date, version,
  222.     ' and conflict information.  This will allow you to see whether a good
  223.     ' version exist on the target system.
  224.     tstr$ = tstr$ & NL & CONFLICT_FILEINOTHERDIR & NL
  225.  
  226.     While clistindex% > 0
  227.         tstr$ = tstr$ & NL & ConflictList(clistindex%).ConflictFile & NL
  228.         ' For now, we'll always display date
  229.         tstr$ = tstr$ & CONFLICT_FILEDATE & TB & ConflictList(clistindex%).ConflictDate & NL
  230.         ' For now, we'll always display size
  231.         tstr$ = tstr$ & CONFLICT_FILESIZE & TB & ConflictList(clistindex%).ConflictSize & NL
  232.         ' For now, we'll always display version
  233.         tstr$ = tstr$ & CONFLICT_FILEVER & TB & ConflictList(clistindex%).ConflictVersion & NL
  234.  
  235.         clistindex% = ConflictList(clistindex%).ConflictNext
  236.     Wend
  237.  
  238.     GetDetailConflictInfo = tstr$
  239. End Function
  240.  
  241. ' This function returns strings describing the fixed file info flags.
  242. Function GetFileFlagDesc(ByVal Flags&) As String
  243.     Dim ret$, comma$
  244.     
  245.     comma$ = ", "
  246.     If Flags& And VS_FF_DEBUG Then
  247.         ret$ = ret$ & FF_DEBUG & comma$
  248.     End If
  249.     If Flags& And VS_FF_INFOINFERRED Then
  250.         ret$ = ret$ & FF_INFOINFERRED & comma$
  251.     End If
  252.     If Flags& And VS_FF_PATCHED Then
  253.         ret$ = ret$ & FF_PATCHED & comma$
  254.     End If
  255.     If Flags& And VS_FF_PRERELEASE Then
  256.         ret$ = ret$ & FF_PRERELEASE & comma$
  257.     End If
  258.     If Flags& And VS_FF_PRIVATEBUILD Then
  259.         ret$ = ret$ & FF_PRIVATEBUILD & comma$
  260.     End If
  261.     If Flags& And VS_FF_SPECIALBUILD Then
  262.         ret$ = ret$ & FF_SPECIALBUILD & comma$
  263.     End If
  264.     If ret$ <> "" Then
  265.         GetFileFlagDesc = Left$(ret$, Len(ret$) - 2)
  266.     End If
  267. End Function
  268.  
  269. '
  270. ' Returns a string listing the warning messages for the specified error flag.
  271. ' The error flag is the Flags parameter from the FileConflict event of the VersionStamper.
  272. '
  273. Function GetWarnings$(ByVal eflags As Long, ByVal delim As String, ByVal fxflags As Long)
  274.     Dim tstr$
  275.     Dim fbit&
  276.     Dim bitcount%
  277.  
  278.     If (eflags = 0) Then Exit Function
  279.  
  280.     For bitcount% = 0 To 12 Step 1
  281.         fbit& = 2 ^ bitcount%
  282.         If (fbit& And eflags) Then
  283.             Select Case bitcount%
  284.                 Case 0: 'Older file was found
  285.                     tstr$ = tstr$ & CONFLICT_OLDERFILE & delim
  286.                 Case 1: 'Newer file was found
  287.                     tstr$ = tstr$ & CONFLICT_NEWERFILE & delim
  288.                 Case 2: 'Older version was found
  289.                     tstr$ = tstr$ & CONFLICT_OLDERVERSION & delim
  290.                 Case 3: 'Newer file was found
  291.                     tstr$ = tstr$ & CONFLICT_NEWERVERSION & delim
  292.                 Case 4: 'Special version was found
  293.                     tstr$ = tstr$ & CONFLICT_SPECIALVERSION & GetFileFlagDesc(fxflags) & delim
  294.                 Case 5: 'Always warn was set
  295.                     tstr$ = tstr$ & CONFLICT_ALWAYSWARN & delim
  296.                 Case 6: 'File was found in memory
  297.                     tstr$ = tstr$ & CONFLICT_FILEINMEMORY & delim
  298.                 Case 7: 'No matching file was found
  299.                     tstr$ = tstr$ & CONFLICT_FILENOTFOUND & delim
  300.                 Case 8: 'No version information detected in this file
  301.                     tstr$ = tstr$ & CONFLICT_VERINFONOTFOUND & delim
  302.                 Case 9: 'No version information detected in this file
  303.                     tstr$ = tstr$ & CONFLICT_FILESIZELARGER & delim
  304.                 Case 10: 'No version information detected in this file
  305.                     tstr$ = tstr$ & CONFLICT_FILESIZESMALLER & delim
  306.                 Case 11: 'No version information detected in this file
  307.                     tstr$ = tstr$ & CONFLICT_NOTINREGISTRY & delim
  308.             End Select
  309.         End If
  310.     Next
  311.  
  312.     GetWarnings = tstr$
  313.     
  314. End Function
  315.  
  316. Sub LoadConflictStruct(vc As VerConflictType, ByVal filename$, ByVal FoundFile$, ByVal eflags&, vsctl As VersionStampDemo)
  317. '
  318. ' Loads the VerConflictType with all of the available information
  319. ' for an embedded file descriptor.  This function can only be called during
  320. ' the FileConflict event for vsctl, since it uses the control's properties
  321. ' to obtain the description information.
  322. '
  323. Dim newsize%, listcount%, curindex%, startindex%, endindex%, otherindex%
  324.     
  325.     ' Set filename
  326.     vc.ReferenceFile = filename$
  327.     vc.ReferenceVersion = vsctl.RefVersion
  328.     vc.ReferenceDate = vsctl.RefDateString
  329.     vc.ReferenceSize = vsctl.RefSize
  330.     vc.ReferenceFlags = vsctl.RefFlags
  331.     listcount% = UBound(ConflictList)
  332.     startindex% = listcount% + 1
  333.     vc.ConflictListIndex = startindex%
  334.     
  335.     'if vsctl.OtherCount = 0, file was not found
  336.     If vsctl.OtherCount > 0 Then
  337.         endindex% = startindex% + vsctl.OtherCount - 1
  338.     Else
  339.         endindex% = startindex%
  340.     End If
  341.  
  342.     'allocate for new items
  343.     ReDim Preserve ConflictList(endindex%)
  344.  
  345.     otherindex% = 0
  346.     For curindex% = startindex% To endindex% Step 1
  347.         If vsctl.OtherCount > 0 Then
  348.             ConflictList(curindex%).ConflictFile = vsctl.OtherFile(otherindex%)
  349.             ConflictList(curindex%).ConflictVersion = vsctl.OtherVersion(otherindex%)
  350.             ConflictList(curindex%).ConflictDate = vsctl.OtherDateString(otherindex%)
  351.             ConflictList(curindex%).ConflictSize = vsctl.OtherSize(otherindex%)
  352.             ConflictList(curindex%).ConflictFXFlags = vsctl.OtherFlags(otherindex%)
  353.         End If
  354.  
  355.         ConflictList(curindex%).ConflictFlags = eflags
  356.         ' If more than one other files were found, create a linked list for them
  357.         If (curindex% <> endindex%) Then
  358.             ConflictList(curindex%).ConflictNext = curindex% + 1
  359.         Else
  360.             ConflictList(curindex%).ConflictNext = -1
  361.         End If
  362.         otherindex% = otherindex% + 1
  363.     Next
  364.  
  365. End Sub
  366.  
  367. Sub LogEnumComplete(vsctl As VersionStampDemo)
  368. Static scanningfiles%
  369.     'reset mousepointer
  370.     Screen.MousePointer = 0
  371.     If vsctl.VerifyMode = 4 Then Exit Sub   'scanning for a single object file
  372.     
  373.     If Not scanningfiles% Then
  374.         'checking file conflicts
  375.         If ConflictFilesFound% > 0 Then Exit Sub
  376.  
  377.         ' If no file conflicts were found, make sure this EXE contains
  378.         ' embedded information, scan it to find out.
  379.         scanningfiles% = True
  380.         EmbedInfoFound% = False
  381.  
  382.         'double check to make sure we scanned a file with embedded information
  383.         If vsctl.VerifyMode = 2 Then
  384.             vsctl.VerifyMode = 3
  385.         Else
  386.             vsctl.ScanFile = FileToCheck$
  387.         End If
  388.     Else
  389.         ' This ends our scanning check.
  390.         scanningfiles% = False
  391.     End If
  392.  
  393. End Sub
  394.  
  395. Sub LogFileConflict(ReferenceFile As String, FoundFile As String, Flags As Long, StopVerify As Integer, vsctl As VersionStampDemo)
  396.     Dim newidx%
  397.     ' Keep count of number of conflicts found.
  398.     ConflictFilesFound% = ConflictFilesFound% + 1
  399.     ' At each one, we add an entry to the global VerScanList
  400.     ' list of information.
  401.     newidx% = UBound(VerConflictList) + 1
  402.     ReDim Preserve VerConflictList(newidx%)
  403.  
  404.     ' We save here the information that we will need.
  405.     ' Save information for EVERY file that caused a conflict.
  406.     LoadConflictStruct VerConflictList(newidx%), ReferenceFile, FoundFile, Flags, vsctl
  407.  
  408. End Sub
  409.  
  410. Sub StartVerify(vsctl As VersionStampDemo)
  411.     'clears global lists and other variables first
  412.     ReDim VerConflictList(0)
  413.     ReDim ConflictList(0)
  414.  
  415.     ConflictFilesFound% = 0
  416.  
  417.     'The file verify may take a while, so bring up hourglass.
  418.     Screen.MousePointer = 11
  419.     'Are we checking this Exe or some other file
  420.     If FileToCheck$ <> "" Then
  421.         ' This method of verifying leaves the VerifyMode property at 0
  422.         vsctl.VerifyFile = FileToCheck$
  423.     Else
  424.         vsctl.VerifyMode = 2
  425.     End If
  426.  
  427. End Sub
  428.  
  429. Sub StopFileScan(ReferenceFile As String, VerifyFlags As Long, StopScan As Integer)
  430.     'This is used to check and make sure the target executable file has
  431.     'embedded information.
  432.     EmbedInfoFound% = True
  433.     'Since all we need to do is make sure at least one file was found
  434.     '(which tells us this EXE has embedded information), we can halt the scan.
  435.     StopScan = True
  436.  
  437. End Sub
  438.  
  439.